home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / SHDK_1 / SHCRCCHK.PAS < prev    next >
Pascal/Delphi Source File  |  1992-03-23  |  8KB  |  210 lines
  1. {$A-}
  2. unit ShCrcChk;
  3. {
  4.                                 ShCrcChk
  5.  
  6.                      A File CRC16 Calculation Unit
  7.  
  8.                                    by
  9.  
  10.                               Bill Madison
  11.  
  12.                    W. G. Madison and Associates, Ltd.
  13.                           13819 Shavano Downs
  14.                             P.O. Box 780956
  15.                        San Antonio, TX 78278-0956
  16.                              (512)492-2777
  17.                              CIS 73240,342
  18.  
  19.                   Copyright 1991 Madison & Associates
  20.                           All Rights Reserved
  21.  
  22.         This file may  be used and distributed  only in accord-
  23.         ance with the provisions described on the title page of
  24.                   the accompanying documentation file
  25.                               SKYHAWK.DOC
  26. }
  27.  
  28. Interface
  29.  
  30. Uses
  31.   DOS;
  32.  
  33. Function CrcCalc(FileName : String) : word;
  34. {
  35.       Calculates the CCITT asynch CRC16 value for file = FileName.
  36. }
  37.  
  38. Function CrcCopy(InFileName, OutFileName : String) : word;
  39. {
  40.       Calculates the CCITT asynch CRC16 value for file=InFileName. If
  41. OutFileName is specified, InFileName is copied to OutFileName. In either
  42. case, the CRC16 value is returned.
  43. }
  44.  
  45. Implementation
  46.  
  47. var
  48.     Buff   : array[1..16384] of Byte;  {The data buffer}
  49.               {Note: Extensive testing has determined that only a slight
  50.                speed-up can be achieved by increasing the buffer size
  51.                further. }
  52.  
  53. const
  54.   CrcTab : array[0..255] of Word =
  55.     ($0000,$1021,$2042,$3063,$4084,$50A5,$60C6,$70E7,
  56.      $8108,$9129,$A14A,$B16B,$C18C,$D1AD,$E1CE,$F1EF,
  57.      $1231,$0210,$3273,$2252,$52B5,$4294,$72F7,$62D6,
  58.      $9339,$8318,$B37B,$A35A,$D3BD,$C39C,$F3FF,$E3DE,
  59.      $2462,$3443,$0420,$1401,$64E6,$74C7,$44A4,$5485,
  60.      $A56A,$B54B,$8528,$9509,$E5EE,$F5CF,$C5AC,$D58D,
  61.      $3653,$2672,$1611,$0630,$76D7,$66F6,$5695,$46B4,
  62.      $B75B,$A77A,$9719,$8738,$F7DF,$E7FE,$D79D,$C7BC,
  63.      $48C4,$58E5,$6886,$78A7,$0840,$1861,$2802,$3823,
  64.      $C9CC,$D9ED,$E98E,$F9AF,$8948,$9969,$A90A,$B92B,
  65.      $5AF5,$4AD4,$7AB7,$6A96,$1A71,$0A50,$3A33,$2A12,
  66.      $DBFD,$CBDC,$FBBF,$EB9E,$9B79,$8B58,$BB3B,$AB1A,
  67.      $6CA6,$7C87,$4CE4,$5CC5,$2C22,$3C03,$0C60,$1C41,
  68.      $EDAE,$FD8F,$CDEC,$DDCD,$AD2A,$BD0B,$8D68,$9D49,
  69.      $7E97,$6EB6,$5ED5,$4EF4,$3E13,$2E32,$1E51,$0E70,
  70.      $FF9F,$EFBE,$DFDD,$CFFC,$BF1B,$AF3A,$9F59,$8F78,
  71.      $9188,$81A9,$B1CA,$A1EB,$D10C,$C12D,$F14E,$E16F,
  72.      $1080,$00A1,$30C2,$20E3,$5004,$4025,$7046,$6067,
  73.      $83B9,$9398,$A3FB,$B3DA,$C33D,$D31C,$E37F,$F35E,
  74.      $02B1,$1290,$22F3,$32D2,$4235,$5214,$6277,$7256,
  75.      $B5EA,$A5CB,$95A8,$8589,$F56E,$E54F,$D52C,$C50D,
  76.      $34E2,$24C3,$14A0,$0481,$7466,$6447,$5424,$4405,
  77.      $A7DB,$B7FA,$8799,$97B8,$E75F,$F77E,$C71D,$D73C,
  78.      $26D3,$36F2,$0691,$16B0,$6657,$7676,$4615,$5634,
  79.      $D94C,$C96D,$F90E,$E92F,$99C8,$89E9,$B98A,$A9AB,
  80.      $5844,$4865,$7806,$6827,$18C0,$08E1,$3882,$28A3,
  81.      $CB7D,$DB5C,$EB3F,$FB1E,$8BF9,$9BD8,$ABBB,$BB9A,
  82.      $4A75,$5A54,$6A37,$7A16,$0AF1,$1AD0,$2AB3,$3A92,
  83.      $FD2E,$ED0F,$DD6C,$CD4D,$BDAA,$AD8B,$9DE8,$8DC9,
  84.      $7C26,$6C07,$5C64,$4C45,$3CA2,$2C83,$1CE0,$0CC1,
  85.      $EF1F,$FF3E,$CF5D,$DF7C,$AF9B,$BFBA,$8FD9,$9FF8,
  86.      $6E17,$7E36,$4E55,$5E74,$2E93,$3EB2,$0ED1,$1EF0);
  87.  
  88. Function CRCResult(Var Table, Buffer; CrcVal, count : integer) : integer;
  89. var temp : integer;
  90. begin
  91. Inline(
  92.  {For I := 1 to Full do
  93.    CRCval := Crctab[hi(CRCval) xor Buff[I]] xor (lo(CRCval) shl 8);}
  94.   $1E/             {   push ds              ;save ds}
  95.   $06/             {   push es              ;save es}
  96.   $C5/$B6/>TABLE/  {   lds si, [bp+>Table]  ;ds:si points to the table}
  97.   $C4/$BE/>BUFFER/ {   les di, [bp+>buffer] ;es:si points to the buffer}
  98.   $8B/$8E/>COUNT/  {   mov cx,[bp+>count]   ;cx has the buffer size}
  99.   $8B/$9E/>CRCVAL/ {   mov bx,[bp+>CRCVal]  ;bx = start CRC value}
  100.   $E3/$25/         {   jcxz Done}
  101.   $89/$D8/         {   mov ax,bx            ;ax = start CRC value}
  102.                    { LooPit:}
  103.   $86/$C4/         {   xchg ah,al           ;al = hi byte}
  104.   $30/$E4/         {   xor ah,ah            ;ax = hi(CRCVal)}
  105.   $31/$D2/         {   xor dx,dx            ;dx = 0}
  106.   $26/             {   es:}
  107.   $8A/$15/         {   mov dl,[di]          ;dx = buffer[i] A BYTE value!!}
  108.   $47/             {   inc di               ;bump di (inc(i))}
  109.   $31/$D0/         {   xor ax,dx            ;ax = hi(CRCVal) xor Buffer[i]}
  110.   $89/$DA/         {   mov dx,bx            ;dx = CRCVal}
  111.   $89/$C3/         {   mov bx,ax            ;bx = hi(CRCVal) xor Buffer[i]}
  112.   $30/$F6/         {   xor dh,dh            ;dx = lo(CRCVal)}
  113.   $51/             {   push cx              ;save counter}
  114.   $B1/$08/         {   mov cl,8             ;need 8 shifts}
  115.   $D3/$E2/         {   shl dx,cl            ;dx = lo(CRCVal) shl 8}
  116.   $59/             {   pop cx               ;restore the counter}
  117.   $D1/$E3/         {   shl bx,1             ;need to mult by 2}
  118.   $3E/             {   ds:}
  119.   $8B/$00/         {   mov ax,[bx+si] ;ax = CRCTAbl[hi(CRCVal xor Buffer[i]]}
  120.   $31/$D0/         {   xor ax,dx      ;ax = CRCTab[hi(CRCVal) xor Buffer[i]]}
  121.                    {                        ;     xor (lo(CRCVal) shl 8)}
  122.   $89/$C3/         {   mov bx,ax            ;bx = new CRCVal}
  123.   $E2/$DD/         {   loop loopit          ;go do it all again}
  124.                    { Done:}
  125.   $89/$9E/>TEMP/   {   mov [bp+>temp],bx    ;bx has the final CRC value}
  126.   $07/             {   pop es               ;restore es}
  127.   $1F);            {   pop ds               ;restore ds}
  128.   CRCResult := temp{                        ;pass it back}
  129. end; {CrcResult}
  130.  
  131. Function CrcCalc(FileName : String) : word;
  132.   var
  133.     FI     : File;
  134.     Full   : Integer;     {How full is the buffer on a block read?}
  135.     CRCval : Integer;
  136.     FileAttr: word;
  137.  
  138.   begin  {CrcCalc}
  139.     CrcVal := 0;
  140.     Assign(FI, FileName);
  141.     GetFAttr(FI, FileAttr);
  142.     SetFAttr(FI, 0);     {can now open any file}
  143.     Reset(FI, 1);
  144.     repeat
  145.       BlockRead(FI, Buff, 16384, Full);
  146.       CrcVal := CrcResult(CrcTab, Buff, CrcVal, Full);
  147.       until Full <= 0;
  148.     Close(FI);
  149.     SetFAttr(FI, FileAttr);    {restore original filemode}
  150.     CrcCalc := CRCval;
  151.     end; {CrcCalc}
  152.  
  153. Function CrcCopy(InFileName, OutFileName : String) : word;
  154. {
  155.       Calculates the CCITT asynch CRC16 value for file=InFileName. If
  156. OutFileName is specified, InFileName is copied to OutFileName. In either
  157. case, the CRC16 value is returned. The DateTime stamp of the input file
  158. is preserved.
  159. }
  160.  
  161.   var
  162.     FI,
  163.     FO     : File;
  164.     Full   : Integer;     {Number of bytes transferred in BlockRead}
  165.     T1     : Integer;
  166.     CRCval : Integer;
  167.     DTStamp: LongInt;
  168.     FileAttr: word;
  169.  
  170.   begin  {CrcCopy}
  171.     CrcVal := 0;
  172.     Assign(FI, InFileName);
  173.     GetFattr(FI, FileAttr);
  174.     SetFAttr(FI, 0);     {can now open any file}
  175.     Reset(FI, 1);
  176.     If OutFileName[0] > #0 then begin
  177.       Assign(FO, OutFileName);
  178.       {$I-}Rewrite(FO, 1);{$I+}
  179.       If IOresult <> 0 then begin
  180.         WriteLn;
  181.         WriteLn('Can''t open file ',OutFileName,'  Aborting...');
  182.         Halt(1);
  183.         end;
  184.       end;
  185.     repeat
  186.       BlockRead(FI, Buff, 16384, Full);
  187.       CrcVal := CrcResult(CrcTab, Buff, CrcVal, Full);
  188.       If (OutFileName[0] > #0) and (Full > 0) then
  189.         {$I-}BlockWrite(FO, Buff, Full);{$I+}
  190.       T1 := IOresult;
  191.       If T1 <> 0 then begin
  192.         WriteLn;
  193.         WriteLn('I/O error ',T1,' writing file. Aborting...');
  194.         Close(FO);
  195.         Erase(FO);
  196.         Halt(1);
  197.         end;
  198.       until Full <= 0;
  199.     GetFTime(FI, DTstamp);
  200.     Close(FI);
  201.     SetFAttr(FI, FileAttr);    {restore original filemode}
  202.     If OutFileName[0] > #0 then begin
  203.       SetFTime(FO, DTstamp);
  204.       Close(FO);
  205.       end;
  206.     CrcCopy := CRCval;
  207.     end; {CrcCopy}
  208.   end.
  209.  
  210.